perm filename VM15.FAI[DAT,LCS]1 blob
sn#502609 filedate 1983-03-31 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE VM PRINTS MUSIC FORMAT FILE ON VARIAN PRINTER.
C00004 00003 BEG: SETOM LINE
C00009 00004 XINI: SKIPN GO
C00012 00005 MOVE A,E ROTATION
C00016 00006 XCHA: SETZ 14, ↓↓MOVE UP AND RIGHT
C00019 00007 MVLFT: MOVMS 0 MOVE LEFT THEN RIGHT
C00022 00008 OOBAR: SETZM OOBFLG GET HERE IF ALL READY OOB
C00026 00009 FINDL: HRRZ A,JOBREL CK IF BIG ENUF
C00032 00010 INBITS: PUSHJ P,NAMGET INPUT OLD BIT FILE
C00034 00011 CORUP
C00036 00012 ******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
C00038 00013 GETNAM: MOVEI A, FILE SCAN
C00040 00014 FILNAM: 0 GLOPS OF JUNK
C00041 ENDMK
C⊗;
TITLE VM ;PRINTS MUSIC FORMAT FILE ON VARIAN PRINTER.
;******** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9
;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
LPDL←←69
NBUFS←←4
DSK←←1
VRN←←2 ;DEVICE NAME OF VARIAN STATOS
LMAR←←=0
RMAR←←=3159
WIDTH←←=3160 ;15.8" WIDE PAPER (DOUBLE SIZE)
LBUFL←←=88 ;LINE LENGTH IN WORDS
LSTBIT←←1⊗34
OVERLAP←←=50
EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF: BLOCK 40
SIGN: 0
LINE: 0
PNTR: 0
BEG: SETOM LINE
GETLIN LINE ;FOR ERROR PRINTOUT
CALLI
HRRZS LINE ;CLEAR LINE BITS
HRRZI A,CORUP
HRRZM A,JOBAPR
SETOM SSS#
HRRZ A,JOBFF ;RESET CORE WITHOUT A RESET
CORE A,
JRST 4,.
MOVEI A,20000 ;REG MPV
APRENB A, ;REG ENABLE OLD WAY!
MOVE P,[-LPDL,,PDL-1]
;Z OUTSTR [ASCIZ /OLD? /]
SETZM BIGBOT#
SETZM GO#
;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
JRST FILIN ;******* NO 'OLD' FEATURE IN THIS VERSION. ******
GONEW: PUSHJ P,FRD ;GO GET DEFAULT FILE NAME.
GOGO: MOVEI =14 ;DEFAULT PAGE LENGTH = 14" WITH 'G'
JRST GOGOGO
LEGLEG: PUSHJ P,FRD
LEGAL: MOVEI =14 ;TYPE 'L' FOR LEGAL SIZE 14"
GOGOGO: MOVEM GO
PUSHJ P,INCHLF
OUTSTR [ASCIZ/USING DEFAULT VALUES.
/]
SETZM ROFLG#
HRREI B,-60 ;??
JRST PASS2
SETZM SPREAD#
FILIN: OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
PUSHJ P,FRD
SKIPE GO
JRST GONEW ;IF 'G' IS NAME THEN USE DEFAULT VALUES.
SETZ A,
YAGN1: HRREI B,-60
SETZM ROFLG
OUTSTR [ASCIZ/ROTATE? /] ;YOU CAN TYPE 'G' FOR GO HERE TOO.
;****** PROBABLY CAN'T ROTATE WITH NEW OUT-OF-BOUNDS FEATURES*******
INCHWL E
CAIE E,"Y"
CAIN E,"y"
SETOM ROFLG ;ROTATE FLAG NOW SET =-1
CAIE E,"G"
CAIN E,"g"
JRST GOGO
CAIE E,"L"
CAIN E,"l"
JRST LEGAL
PUSHJ P,INCHLF ;GO LOOK FOR THE LINE FEED
SKIPN ROFLG ;ROTATE?
JRST .+3 ;NO, SKIP NEXT
OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=7.0(CENTER))? /]
SKIPA
OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=7.9(CENTER))? /]
PUSHJ P,RNUM
JRST [ PASS2: HRREI A,-=1485
SKIPE ROFLG ;ROTATE?
HRREI A,-=1400 ; YES, DEFAULT = 7"
JRST YDEF] ;GET Y INFO
IMULI A,=100
CAIN C,"." ;DECIMAL POINT?
JRST [ INCHWL C
CAIN C,15
INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST .+1
SUBI C,60
IMULI C,=10
SKIPE SIGN
MOVN C,C
ADD A,C
PUSH P,A
PUSHJ P,RNUM
JFCL
POP P,A
JRST .+1] ;.+1??
MOVN A,A
LSH A,1 ;*2 (MAKE IT STEPS)
CAIE C,12 ;DID IT GET A LF?
PUSHJ P,INCHLF ;NO, GO LOOK
YDEF: ADD A,B
MOVNM A,INIX#
AGAIN: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
OPEN DSK,[14↔'DSK '↔IBUF]
JRST 4,.
INBUF DSK,NBUFS
LOOKUP DSK,LKENT
JRST FNF
ASKLEN: SETZM POOBX#
SETZM POOBY#
PUSHJ P,XINI ;GET X INFO
SETZM XX#
SETZM YY#
MOVEI C,3
HRRZM C,PENN#
READ1: IN DSK, ;READ FIRST BUFFER
SKIPA
HALT ;ERROR
HRR C,IBUF+1
MOVN E,1(C) ;LOOK FOR SIZE FACTOR. IF FOUND SKIP THIS BUFFER.
CAIGE E,177 ;FIRST WD HAS SIZE * 1000, NOT WDCNT
MOVNI E,177
JRST PLOTX ;IF(E.LT.-177)E=-177
OUTER: IN DSK,
JRST PLOT
STATO DSK,20000
JRST 4,.
RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
JRST PCUT
INCHLF: INCHWL 0 ;GET ANOTHER CHARACTER
CAIE 0,12 ;WAS IT A LF?
JRST INCHLF ;GET THE LF
POPJ P,
XINI: SKIPN GO
OUTSTR [ASCIZ /LENGTH-INCHES (Y DIM. MAX=14, DEFAULT=14)? /]
SETZM DEFA#
SKIPE GO
JRST PASSD
PUSHJ P,RNUM
SETOM DEFA ;ASSUME 14 INCHES
JUMPLE A,[XINLER:INCHWL 0 ; GET LF?
JRST XINI]
SKIPGE DEFA ;? GO?
PASSD: HRRZI A,=14
SKIPE GO
MOVE A,GO
;;PASSD: MOVE A,GO ;EITHER 11 OR 14
CAIE C,12
JRST XINLER
IMULI A,=200
CAILE A,=2800 ;IF MORE THAN 14" IS TYPED, WE GET 14"
MOVEI A,=2800 ;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
PUSH P,A
YINI1: SKIPE GO
JRST PASS3
SKIPL ROFLG
OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=4)? \]
SKIPGE ROFLG
OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
PUSHJ P,RNUM
PASS3: JRST [ MOVEI A,=4
SKIPE BIGBOT ;BIGBOT=NEG=200 BOTTOM MARGIN
MOVEI A,=200
SKIPGE ROFLG
MOVEI A,=1000
JRST IYDEF]
CAIE C,12
JRST [ PUSHJ P,INCHLF
JRST YINI1]
IYDEF: MOVEM A,SHIFT# ;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
;;IYDEF: IMULI A,LBUFL+1
;; MOVEM A,IYPOS#
POP P,A
XDEF: MOVEM A,LINCNT#
MOVEI B,-1(A)
IMULI A,LBUFL+1 ;A← BUFSIZ ← ROWS * COL
MOVE T,JOBFF ;GET START ADDR
MOVEM T,XGPPTR
SOS XGPPTR
MOVEI T,2(A)
MOVNI TT,(T)
ADD T,XGPPTR
HRLM TT,XGPPTR ;XGPPTR← -WDCNT,,ADDR-1
MOVE TT,T
HRRZ L,XGPPTR
MOVSI T,1(L)
HRRI T,2(L)
SETZM 1(L)
MOVE U,JOBREL
BLT T,(U) ;ZERO TO END OF CORE
HRRZI U,(TT)
MOVEM B,SVBBB#
;; MOVE Y,IYPOS
;; ADDI Y,2(L)
MOVEI Y,2(L)
MOVEI XD,DBUF+1
SKIPL A,INIX ;WHERE DO WE START
JRST MAYBON
SUBI A,43
IDIV A,[-44]
HRLOI X,XD
SOJA A,SETB
MAYBON: ADDI A,43
IDIVI A,44
CAILE A,LBUFL
JRST OFFRT
MOVE X,A
SETZ A,
HRLI X,Y
JRST SETB
OFFRT: MOVE X,[XD,,LBUFL]
SUBI A,LBUFL
SETB: MOVE B,INIX
IDIVI B,44
MOVSI B,400000
MOVN C,C
ROT B,(C)
POPJ P,
POPJ1: AOS (P)
CPOPJ: POPJ P,
MOVE A,E ;ROTATION
ROTA: MOVE 14,2(A)
LSHC 14,-10
HLLZ C,15
LSHC 14,-16
HLLZ D,15
LSHC 14,-16
EXCH 15,D
LSHC 14,16
ASH D,-26
MOVN 15,D
LSH 15,26
LSHC 14,16
HLLZ 15,C
LSHC 14,10
MOVEM 14,2(A)
AOBJN A,ROTA
JRST PLOT1
PLOT: HRR C,IBUF+1
MOVN E,1(C) ;FIX FOR NO WDCNT
PLOTX: MOVSI E,(E)
HRR E,IBUF+1
SKIPGE ROFLG
JRST ROTA-1
PLOT1: MOVE 14,2(E)
LSHC 14,-10
ASH 15,-34
JUMPG 15,NORSET ;NEXT FOR RESET OF COORDS TO 0,0 (SVPEN=-1)
LSHC 14,-16
ASH 15,-26
ADDM 15,SHIFT ;PUSH UP SHIFT
JRST ENOUT ;IGNORE THE REST OF THIS WORD
NORSET: MOVEM 15,SVPEN# ;GET PEN CODE - NO RESET
MOVM A,15
LSHC 14,-16
ASH 15,-26
SSSS: ADD 15,SHIFT# ;SHIFTS ONLY AFTER (0,0) IS SET (SVPEN=-3)
MOVEM 15,SVY# ;GET Y
SUB 15,YY
MOVEM 15,SVYSB# ;SAVE Y DIFF
IMULI 15,LBUFL+1
ADD 15,Y
CAMGE 15,[=262144] ;2↑18
SKIPG 15 ;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
JRST ENOUT ;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
YOK: MOVEM 15,SVYOD# ;SAVE NEW Y
CAIGE 15,(L) ;OFF BOTTOM
JRST LOSE
CAIL 15,-LBUFL-1(U) ;OFF TOP
JRST LOSE
LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX# ;GET X
SUB 15,XX
MOVE 0,15 ;0 HAS X DIFF
HRRZ 16,X
IMULI 16,44 ;TIMES BITS INA WORD
JFFO B,.+1
ADD 16,C ;PLUS REMAINDER EQ OLD X
SUB 16,15
JUMPL 16,LOSEX
CAILE 16,=4427
JRST LOSEX
SKIPE OOBFLG# ;CK IF ALREADY OOB
JRST OOBAR
FIXUP: CAIE A,1 ;FIXUP WHAT?
HRRM A,PENN
HRR A,PENN ;SAME PEN IF 1
CAIN A,3
JRST PENUP ;PENUP IF 3
MOVE C,SVYSB ;Y DIFF
IORM B,@X ;MARK NOW X Y
;FIND DIRECTION
JUMPE NORMX ;VERT OR NO MOVE
JUMPL MVLFT ;LEFT
JUMPE C,NRT ;HORZ
JUMPL C,MVDWN ;DOWN
CAMLE C,0 ;JUMP IF Y DIFF > X DIFF
JRST XCHA
SETZ 14, ;↓↓ MOVE UP AND RIGHT
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOOP
JRST DONXT
XCHA: SETZ 14, ;↓↓MOVE UP AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INLOO: ADD 15,0
TLZN 15,200000
JRST MVUP
SKIPGE B
SOJ X,
ROT B,1
MVUP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,INLOO
JRST DONXT
MVDWN: MOVMS C ;↓↓MOVE DOWN AND RIGHT
CAMLE C,0
JRST XCHA2 ;JUMP IF YDIFF > XDIFF
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
INLOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG INLOP
JRST DONXT
XCHA2: SETZ 14, ;↓↓MOVE DOWN AND RIGHT
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
INOOP: ADD 15,0
TLZN 15,200000
JRST MVEX
SKIPGE B
SOJ X,
ROT B,1
MVEX: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,INOOP
JRST DONXT
NRT: JUMPL B,GOOP ;HORZ RIGHT
TOOT: ROT B,1
IORM B,@X
SOJG 0,NRT
JRST DONXT
GOOP: SOJ X,
CAIGE 0,44
JRST TOOT
IDIVI 0,44
SETOM @X
SOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,TOOT
AOJ X,
JRST DONXT
NLFT: MOVMS 0 ;HORZ LEFT
ROT B,-1
JUMPL B,ROOT
WOOP: IORM B,@X
SOJG 0,.-3
JRST DONXT
ROOT: AOJ X,
CAIGE 0,44
JRST WOOP
IDIVI 0,44
SETOM @X
AOJ X,
SOJG 0,.-2
HRR 0,1
JUMPN 0,WOOP
SOJ X,
ROT B,1
JRST DONXT
;;NORMX: JUMPE C,NOMOVE ;NO DIFF
NORMX: JUMPE C,ENOUT ;NO DIFF
JUMPL C,MDOWN ;MOVE VERT DOWN
MUP: ADDI Y,LBUFL+1 ;MOVE VERT UP
IORM B,@X
SOJG C,MUP
JRST DONXT
MDOWN: SUBI Y,LBUFL+1 ;MOVE VERT DOWN
IORM B,@X
AOJL C,MDOWN
DONXT: MOVE 4,SVX ;DONE. NOW UPDATE X AND Y
MOVEM 4,XX
NXTY: MOVE 4,SVY
MOVEM 4,YY
;;NOMOVE: SKIPL SVPEN ;****** THIS DONE AT 'PLOT' NOW
;; JRST ENOUT
;; SETZM XX ;IF NEW LOCO
;; SETZM YY
ENOUT: AOBJN E,PLOT1 ;GET NEXT
JRST OUTER
MVLFT: MOVMS 0 ;MOVE LEFT THEN RIGHT
MOVMS 15
JUMPE C,NLFT
HRR Y,SVYOD
IDIVI 15,44
ADD X,15
XEND: SOJL 16,DUN
ROT B,-1
JUMPGE B,XEND
AOJ X,
JRST XEND
DUN: MOVEM X,XX ;SAVE NEW X POS
MOVEM B,YY
IORM B,@X
JUMPL C,MVLD
CAMLE C,0
JRST XCHA3
SETZ 14, ;MOVE LEFT UP
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
ILOOP: ADD 15,C
TLZE 15,200000
SUBI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG ILOOP
JRST BFOR
XCHA3: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
ILOP: ADD 15,0
TLZN 15,200000
JRST DOQ
SKIPGE B
SOJ X,
ROT B,1
DOQ: SUBI Y,LBUFL+1
IORM B,@X
SOJG C,ILOP
JRST BFOR
MVLD: MOVMS C ;MOVE LEFT DOWN
CAMLE C,0
JRST XCHA4
SETZ 14,
TLNE C,200000
JRST .+4
LSH C,1
TRO C,1
AOJA 14,.-4
SUBI 14,=34
IDIV C,0
MOVNS 14
LSH C,(14)
SETZ 15,
LOOP: ADD 15,C
TLZE 15,200000
ADDI Y,LBUFL+1
SKIPGE B
SOJ X,
ROT B,1
IORM B,@X
SOJG LOOP
JRST BFOR
XCHA4: SETZ 14,
TLNE 0,200000
JRST .+4
LSH 0,1
TRO 0,1
AOJA 14,.-4
SUBI 14,=34
IDIV 0,C
MOVNS 14
LSH 0,(14)
SETZ 15,
LOP: ADD 15,0
TLZN 15,200000
JRST DOP
SKIPGE B
SOJ X,
ROT B,1
DOP: ADDI Y,LBUFL+1
IORM B,@X
SOJG C,LOP
BFOR: HRR Y,SVYOD ;RESTORE PEN TO NEW PEN
MOVE X,XX
MOVE B,YY
JRST DONXT
OOBAR: SETZM OOBFLG ; GET HERE IF ALL READY OOB
AOSG SSS ; THIS IS FOR THE FIRST OOB FROM MP
JRST FIXUP ;
PENUP: HRR Y,SVYOD ; PEN IS UP GET NEW Y
JUMPE 15,NXTY ;IF VERT
JUMPL 15,PULFT ;IF LEFT
CAIGE 15,44 ;↓↓MOVE UP PEN RIGHT TO NEW X
JRST XLOOP
IDIVI 15,44
SUB X,15
HRR 15,16
XLOOP: SOJL 15,DONXT
SKIPGE B
SOJ X,
ROT B,1
JRST XLOOP
PULFT: MOVMS 15 ;↓↓MOVE UP PEN LEFT TO NEW X
CAIGE 15,44
JRST OOO
IDIVI 15,44
ADD X,15
HRR 15,16
OOO: SOJL 15,DONXT
ROT B,-1
JUMPGE B,OOO
AOJ X,
JRST OOO
LOSEX: SETOM OOBFLG ;OOB X
SKIPE POOBX
JRST PENUP
SETOM POOBX
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
JUMPL 16,[PUSHJ P,ERRPNT
ASCIZ/-X/
JRST PENUP]
PUSHJ P,ERRPNT
ASCIZ/+X/
JRST PENUP
LOSE: SETOM OOBFLG ;OOB Y
SKIPE POOBY
JRST LOBAC
SETOM POOBY
PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ / POINT OUT OF BOUNDS, /
CAIGE 15,(L)
JRST [ PUSHJ P,ERRPNT
ASCIZ/-Y/
JRST LOBAC]
PUSHJ P,ERRPNT
ASCIZ/+Y/
LOBAC: LSHC 14,-16
ASH 15,-26
MOVEM 15,SVX
SUB 15,XX
JRST PENUP
DECOUT: IDIVI T,=10 ;DEC TTY OUT
HRLM TT,(P)
SKIPE T
PUSHJ P,DECOUT
HLRZ TT,(P)
ADDI TT,60
ROT TT,-7
MOVEM TT,.+2
PUSHJ P,ERRPNT
0
POPJ P,
ERRPNT: HRRZ TT,(P) ;ERROR TTY OUT
MOVEM TT,PNTR
MOVEI TT,LINE
TTYMES TT,
JRST [ OUTSTR[ASCIZ/TTYMES FAILED /]
OUTSTR @PNTR
OUTSTR[ASCIZ/
/]
JRST .+1]
POP P,TT
HRL TT,(TT)
TLNE TT,376
AOJA TT,.-2
JRST 1(TT)
XERR: PUSHJ P,ERRPNT ;DET TTY OUT
ASCIZ/
MESSAGE FROM X WORKING ON /
MOVE TT,FILNAM
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/./
HLLZ TT,FILEXT
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/[/
MOVE TT,FILPPN
PUSHJ P,SIXOUT
PUSHJ P,ERRPNT
ASCIZ/] : /
POPJ P,
SIXOUT: JUMPE TT,CPOPJ ;SIXBIT OUT
SETZ T,
LSHC T,6
ADDI T,40
PUSH P,TT
ROT T,-7
MOVEM T,.+2
PUSHJ P,ERRPNT
0
POP P,TT
JRST SIXOUT
DETCHK: SETOM DET# ;CK FOR DET JOB
GETLIN DET
HRRES DET
SKIPL DET
AOS (P)
POPJ P,
FINDL: HRRZ A,JOBREL ;CK IF BIG ENUF
CAIL A,-LBUFL-1(U)
JRST XINL-1
XL2: MOVEM TT,(T) ;ADD MORE AND MARK
ADDI T,LBUFL+1
CAIGE T,(A)
JRST XL2
SUBI A,(L)
MOVNS A
HRLM A,XGPPTR
SUBI T,LBUFL+1
JRST XXOUT
PCUT: HRRZ L,XGPPTR ;MARK BLOCK FOR XGP
MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
MOVEM TT,1(L) ;FIRST ONE HAS MARK AND CUT WITH IT
TLZ TT,400000 ;DELETE MARK AND CUT
MOVEI T,1+LBUFL+1(L)
SKIPGE DEFA
JRST FINDL
MOVE B,SVBBB
XINL: MOVEM TT,(T)
ADDI T,LBUFL+1
SOJG B,XINL
HLRO TT,XGPPTR
MOVNS TT
ADDI TT,(L)
MOVE A,(TT)
XXOUT: MOVSI TT,400100
MOVEM TT,(T) ;SO DOES LAST
SKIPN SPREAD
JRST XGPOUT
HRRZ T,XGPPTR
ADDI T,LBUFL+1
HRRZ C,SVBBB
SKIPG SPREAD
JRST NINE
XLINE4: HRLI T,-LBUFL
XSHFT4: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT4
AOJ T,
SOJG C,XLINE4
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE4: HRLI T,-LBUFL
YSHFT4: MOVE A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT4
AOJ T, ;Bump past control word.
SOJG B,YLINE4
JRST XGPOUT
NINE: HRLI T,-LBUFL
XSHFT9: MOVE A,2(T)
MOVE B,3(T)
ROTC A,1
ORM A,2(T)
ROTC A,1
ORM A,2(T)
AOBJN T,XSHFT9
AOJ T,
SOJG C,NINE
HRRZ T,XGPPTR
HRRZ B,SVBBB
YLINE9: HRLI T,-LBUFL
YSHFT9: MOVE A,LBUFL+LBUFL+4(T)
OR A,LBUFL+3(T)
ORM A,2(T)
AOBJN T,YSHFT9
AOJ T,
SOJG B,YLINE9
XGPOUT: OPEN VRN,XNIT ;XGP OUTPUT
;;; PUSHJ P,NOXGP
JRST NOXGP
OUTSTR[ASCIZ/CRANKING VRN
/]
LOCK
OUTIT: OUT VRN,XGPPTR
JRST OUTOK
DSKERR: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /VRN OUTPUT ERROR.
/
OUTOK: UNLOCK
RELEAS VRN,
XMORE: PUSHJ P,DETCHK
;; JRST DODEL ;DELETE AUTOMATICALLY IF DETACHED
JFCL
OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT /]
INCHRW C
CAIE C,15
JRST .+3
INCHRW C
JRST XMORE+2 ; WON'T ACCEPT JUST CRLF
OUTSTR[ASCIZ/
/]
CAIE C,"X"
CAIN C,"x"
SKIPA
JRST .+3
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
JRST NODEL
CAIE C,"R"
CAIN C,"r"
JRST XGPOUT
CAIE C,"D"
CAIN C,"d"
SKIPA ;IF NOT R, X OR D TRY AGAIN.
JRST XMORE+2
PUSHJ P,CORDWN ;REALLY DONE, CORE DOWN
DODEL: MOVE A,[FILNAM,,LKENT]
BLT A,LKENT+3
INIT DSK,17
'DSK '
0
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/COULDN'T GET DISK FOR DELETE!
/
JRST NODEL]
LOOKUP DSK,LKENT
JRST [ SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/LOOKUP FOR DELETE FAILED!
/
JRST NODEL]
MOVE A,FILPPN
MOVEM A,LKENT+3
SETZM LKENT
RENAME DSK,LKENT
CAIA
JRST NODEL
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL: RELEASE DSK,
SKIPGE DET
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ/ALL DONE!
/
CALLI 12 ;LEAVE
NOXGP: PUSHJ P,DETCHK
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /
WAITING FOR VRN /
;ZZ ASCIZ /
;ZZXGP BUSY, OUTPUT TO DISK? /
;ZZ INCHRW A
;ZZ CAIE A,"Y"
;ZZ CAIN A,"y"
;ZZ JRST OUTFIL
HRRZI A,1017
HRRZM A,XNIT
;;; POPJ P,
JRST XGPOUT
XNIT: 417
'VRN '
0
XGPPTR: BLOCK 2
IFN LSTBIT-1,<
XFIX: MOVE A,[LSTBIT-1]
HRRZ C,JOBREL
HRRZ D,XGPPTR
XFIXL: ANDCAM A,LBUFL-1+2(D)
ADDI D,LBUFL+1
CAIGE D,(C)
JRST XFIXL
POPJ P,
>
CORDWN: MOVE T,JOBFF
SUBI T,1
CALLI T,11
JRST 4,.
POPJ P,
INBITS: PUSHJ P,NAMGET ;INPUT OLD BIT FILE
HRRZ U,JOBFF
HRRZI T,177(U)
CORE T,
JRST INBITS
SOJ U,
HRLI U,-200
OPEN [17↔'DSK '↔0]
JRST INBITS
LOOKUP FILNAM
JRST INBITS
SETZ 10,
TRYTRY: OPEN VRN,XNIT ;***** GRAB THE VRN BEFORE CORE EXPANSION
JRST NONO ;CAN'T GET IT!
INPUT U
MOVE T,[BYTE (12)4001,LMAR,LBUFL]
EXCH T,1(U)
HLL U,T
MOVEM U,XGPPTR
HRLI U,(T)
TLNN U,777777
JRST CLOZE
ADDI U,200
MOVNI T,(T)
ADDI T,(U)
CORE T,
JRST INBITS ;HANG
INPUT U
CLOZE: RELEAS
JRST XGPOUT
NONO: OUTSTR[ASCIZ/
WAITING FOR VRN /]
HRRZI A,1017
HRRZM A,XNIT
JRST TRYTRY
OUTFIL: PUSHJ P,NAMGET ;OUTPUT BIT FILE
MOVE U,XGPPTR
HLRO T,U
MOVNS T
TRZ T,177
HRRZI A,200(T)
ADDI A,(U)
CORE A,
JRST OUTFIL
MOVNS T
HLL T,U ;FIRST WD IS WC-200,-WC
MOVEM T,1(U)
HRLI U,-200(T)
SETZ 10,
OPEN [17↔'DSK '↔0]
JRST 4,.
ENTER FILNAM
CAIA
OUTPUT U
RELEAS
JRST NODEL
;CORUP
CORUP:
REPEAT 0,< OLD WAY - FLUSHED BY REG 1-3-76
HRRZ B,JOBCNI
CAIE B,20000
DISMIS
MOVE A,JOBTPC
MOVEM A,IPC+1
UWAIT
DEBREAK
>;END REPEAT 0
BUST: MOVEM 1,SVONE#
MOVEM 2,SVTWO#
MOVEM TT,SVTTT#
MOVE 1,JOBCNI ;REG GET APR CONI BITS
TRNN 1,20000 ;REG IS THERE AN MPV?
JRST NOMPV ;REG NO
HRRZ 1,JOBREL ;OLD CORE SIZE
MOVSI 2,1(1) ;FIRST NEW WORD WE'LL GET
HRRI 2,2(1) ;SECOND NEW WORD - 2 HAS A BLT POINTER.
ADDI 1,16000
;; ADDI 1,10000 ;GET ANOTHER 8K
MOVE TT,1
CORE 1,
PUSHJ P,CORLUZ
HRRZ 1,JOBREL
SETZM -1(2)
BLT 2,(1) ;ZERO NEW CORE
MOVE 1,SVONE
MOVE 2,SVTWO
MOVE TT,SVTTT
REPEAT 0,<
INTJEN IPC
>
JRST 2,@JOBTPC ;REG THIS IS HOW TO DISMISS OLD INTERRUPT
NOMPV: OUTSTR [ASCIZ/UNEXPECTED INTERRUPT?
/]
JRST 2,@JOBTPC
CORLUZ: MOVE T,TT
LSH T,-12
PUSH P,T
PUSHJ P,DETCHK
PUSHJ P,XERR
POP P,T
PUSHJ P,DECOUT
PUSHJ P,ERRPNT
ASCIZ / K OF CORE NEEDED!
/
SKIPGE DET
CALLI 12
JRST ASKLEN
FNF: PUSHJ P,DETCHK ;FILE NOT FOUND
PUSHJ P,XERR
PUSHJ P,ERRPNT
ASCIZ /LOOKUP FAILED.
/
SKIPGE DET
CALLI 12
JRST FILIN
;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
FRD: MOVSI A,'PLT' ;FILE SCAN
MOVEM A,FILEXT
SKIPN GO
JRST .+3 ;GO?
MOVEI C,12 ; CR
JRST .+3
PUSHJ P,GETNAM
CAME A,[SIXBIT/G/] ;G ALONE = 'GO'
JRST GOX
SETOM GO ;GO BACK AND USE DEFAULT NAME.
POPJ P,
;;GOX: CAME A,[SIXBIT/:/] ;FOR * FOUR
GOX: CAME A,[SIXBIT/4/] ;FOR * FOUR
JRST CKSEMI
AOS SPREAD
THICK: OUTSTR [ASCIZ/*** THICKER LINES ***
/]
POPBAC: POP P,A
PUSHJ P,INCHLF
;C CLRBFI
JRST FILIN
CKSEMI: CAME A,[SIXBIT/9/] ;FOR * NINE
;;CKSEMI: CAME A,[SIXBIT/;/]
JRST CKDEFA
SETOM SPREAD
JRST THICK
CKDEFA: SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXT
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXT: CAIE C,"["
JRST FRDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FRDX: SKIPN GO
INCHRW C
CAIE C,12
JRST FRDX
POPJ P,
RNUM: INCHWL C ;NUM SCAN
CAIN C,15
JRST RNUM
CAIN C,12
POPJ P,
AOS (P)
MOVEI A,
SETZM SIGN
CAIN C,"-"
JRST [ PUSHJ P,RNUML
SETOM SIGN
MOVN A,A
POPJ P,]
CAIN C,"+"
RNUML: INCHWL C
CAIL C,"0"
CAILE C,"9"
JRST RNUMX
IMULI A,12
ADDI A,-"0"(C)
JRST RNUML
RNUMX: CAIN C,15
INCHRW C
POPJ P,
GETNAM: MOVEI A, ;FILE SCAN
MOVE B,[440600,,A]
GETNML: PUSHJ P,RCH
POPJ P,
SUBI C,40
TLNE B,770000
IDPB C,B
JRST GETNML
GETP: MOVEI A,
GETPL: PUSHJ P,RCH
POPJ P,
TRNE A,770000
JRST GETPL
LSH A,6
ADDI A,-40(C)
JRST GETPL
RCH: INCHWL C
CAIN C,42
JRST RCHQ
CAIE C,11
CAIN C," "
JRST RCH
CAIE C,"."
CAIN C,","
POPJ P,
CAIE C,"["
CAIN C,"]"
POPJ P,
RCHQR: CAIGE C,40
POPJ P,
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,40
JRST POPJ1
RCHQ: INCHWL C
JRST RCHQR
;CNAMGET: CLRBFI
;CCNAMGET: INCHWL 0
;CC INCHWL 0 ;GET CRLF
;CC INCHWL 0
;CC INCHWL 0 ;GET CRLF
NAMGET: PUSHJ P,INCHLF
OUTSTR [ASCIZ/
FILE = /]
SETZM FILEXT+1
SETZM FILPPN
MOVSI A,'BIT'
MOVEM A,FILEXT
PUSHJ P,GETNAM
SKIPN A
MOVE A,['PLT ']
MOVEM A,FILNAM
CAIE C,"."
JRST NOEXTN
PUSHJ P,GETNAM
MOVEM A,FILEXT
NOEXTN: CAIE C,"["
JRST FFDX
PUSHJ P,GETP
HRLZM A,FILPPN
PUSHJ P,GETP
HRRM A,FILPPN
FFDX: INCHRW C
CAIE C,12
JRST FFDX
POPJ P,
FILNAM: 0 ;GLOPS OF JUNK
FILEXT: 0
0
FILPPN: 0
LKENT: BLOCK 4
XGSNAM: 0
XGSEXT: 0
0
XGSPPN: 0
IBUF: BLOCK 3
BITTAB: FOR I←43,0,-1{1⊗I
}
BYTTAB: FOR I←36,0,-6{REPEAT 6,{77⊗I}}
DBUF: BLOCK LBUFL+2
PDL: BLOCK LPDL
END BEG